home *** CD-ROM | disk | FTP | other *** search
/ El Mac 8 / El Mac 8.iso / Shareware / Applications / 4th Artificial Life / ChaseNet.4th < prev    next >
Encoding:
Text File  |  1996-03-15  |  5.5 KB  |  130 lines  |  [TEXT/MSWD]
  1. \ ****** ChaseNet  in  FORTH  by  MERVYN@xs4all.nl *******
  2. --> Extended.4th
  3. variable A 300 allot  variable B 300 allot  
  4. variable X 10 allot  variable Y 10 allot  
  5. variable N variable HEAD variable P variable EYE variable DIR
  6. variable SC  variable SC0 variable SCM variable SOM variable MAX
  7. variable SP variable T variable GEN  create "TITLE" ," ChaseNet" 
  8. : INIT randomize 44 N !  1 HEAD !  0 P !  0 SC !  0 SCM ! 0 T ! 0 SP ! 0 SC0 !
  9.     1 X ! 1 Y ! 12 2 Do 5 X I + ! 5 Y I + ! 2 +Loop 0 GEN ! 0 MAX !
  10.     250 200 Do 10 A I + !  10 B I + !    2 +Loop 
  11.     200 0 do 0 A I + !  2 +Loop 
  12.     BLACK bcolor WHITE fcolor 500 300 wsize "TITLE" wtitle page
  13.     ." ChaseNet  by  Mervyn@xs4all.nl (programmed in Forth)" CR CR
  14.     ." ChaseNet demonstrates how a neural net can be used to solve" CR
  15.     ." a problem. This Neural Net is trained by means of 'hill climbing'."  CR
  16.     ." The factors are randomly changed and stored when they break" CR
  17.     ." the 'HiScore'. If not, then the last Net will be restored." CR
  18.     ." The Net is linked to a virtual robot with 4 eyes and two wheels." CR
  19.     ." The top of the net is the input: 4 eyes and one channel that" CR
  20.     ." is activated when no eye is activated. The 'eyes' can only " CR
  21.     ." indicate if an object is present in that direction or not. " CR
  22.     ." So the input indicators are: front right behind left nothing" CR
  23.     ." The output is the two wheels. " CR
  24.     ." The robot is shown as a digit that indicates its direction:" CR
  25.     ." 1) north 2) east 3) south 4) west" CR
  26.     ." The robot 'scores' each step its drives over the screen." CR
  27.     ." This score resets however when it reaches an edge of the screen!" CR  
  28.     ." As a result the robot will chase the only object (O) it can see" CR
  29.     ." and thereby have a better score than just the ten steps from" CR
  30.     ." one side of the screen to the other!" CR
  31.     ." (the object jumps away when it is noticed by the robot!) " CR
  32.     ." Note that it is a strange criterium to solve the" CR
  33.     ." problem: let the robot chase the object..." key drop page  
  34.     130 0 !pen 130 115 -to 0 115 -to ;
  35. : INPUT 12 0 do 0 A I + !  2 +Loop 
  36.     0 DIR !
  37.     Y @  Y 2 + @ < if X @ X 2 + @ = if 1 DIR ! then else
  38.     Y @  Y 2 + @ > if X @ X 2 + @ = if 3 DIR ! then else
  39.     X @  X 2 + @ < if Y @ Y 2 + @ = if 4 DIR ! then else
  40.     X @  X 2 + @ > if Y @ Y 2 + @ = if 2 DIR ! then then then then then
  41.     DIR @ 0 > if 
  42.         DIR @ HEAD @ 1 - - dup EYE ! 1 < if 4 EYE +! then
  43.         1 A EYE @ 2 * + !   else 1 A 10 + ! then
  44.     X 2 + @  X 4 + !    Y 2 + @  Y 4 + ! ;
  45. : THINK
  46.     A 2 + @  202 A + @ *  
  47.     A 4 + @  204 A + @ * + 
  48.     A 6 + @  206 A + @ * +
  49.     A 8 + @  208 A + @ * +  
  50.     A 10 + @  210 A + @ * + 
  51.     10 > if 1 A 20 + ! else 0 A 20 + ! then 
  52.     A 2 + @  212 A + @ *  
  53.     A 4 + @  214 A + @ * + 
  54.     A 6 + @  216 A + @ * +
  55.     A 8 + @  218 A + @ * +  
  56.     A 10 + @  220 A + @ * + 
  57.     10 > if 1 A 22 + ! else 0 A 22 + ! then 
  58.     A 2 + @  222 A + @ *  
  59.     A 4 + @  224 A + @ * + 
  60.     A 6 + @  226 A + @ * +
  61.     A 8 + @  228 A + @ * +  
  62.     A 10 + @  230 A + @ * + 
  63.     10 > if 1 A 24 + ! else 0 A 24 + ! then 
  64.     A 20 + @  232 A + @ *  
  65.     A 22 + @  234 A + @ * + 
  66.     A 24 + @  236 A + @ * +
  67.     10 > if 1 A 26 + ! else 0 A 26 + ! then 
  68.     A 20 + @  238 A + @ *  
  69.     A 22 + @  240 A + @ * + 
  70.     A 24 + @  242 A + @ * +
  71.     10 > if 1 A 28 + ! else 0 A 28 + ! then ;
  72. : OUTPUT    
  73.         A 26 + @ A 28 + @ + 2 =                 if HEAD @ 
  74.         dup 1 = if -1 Y 2 + +! 1 SC +! drop else            
  75.         dup 2 = if 1 X 2 + +! 1 SC +! drop else
  76.         dup 3 = if 1 Y 2 + +! 1 SC +! drop else
  77.                4 = if -1 X 2 + +! 1 SC +! then then then then      
  78.         X 2 + @ dup 1 < if 10 X 2 + ! 50 T ! drop else
  79.                      10 > if 1 X 2 + ! 50 T !  else
  80.         Y 2 + @ dup 1 < if 10 Y 2 + ! 50 T !  drop else
  81.                 10 > if 1 Y 2 + ! 50 T !  then then then then 
  82.                                         else
  83.         A 26 + @ 1 = if 1 HEAD +! then
  84.         A 28 + @ 1 = if -1 HEAD +! then
  85.         HEAD @ dup 1 < if 4 HEAD +! drop else 
  86.                    4 > if -4 HEAD +! then then     then ;
  87. : VIEWNET 
  88.     10 0 Do 150 220 !PEN 50 I 50 * + 150 -TO  A 202 + I + @ .  2 +Loop
  89.     10 0 Do 250 220 !PEN 50 I 50 * + 162 -TO  A 212 + I + @ .  2 +Loop
  90.     10 0 Do 350 220 !PEN 50 I 50 * + 174 -TO  A 222 + I + @ .  2 +Loop
  91.     6 0 Do 200 270 !PEN 150 I 50 * + 220 -TO  A 232 + I + @ .  2 +Loop
  92.     6 0 Do 300 270 !PEN 150 I 50 * + 232 -TO  A 238 + I + @ .  2 +Loop ;
  93. : JUMPAWAY 3 random 1 - X +!  3 random 1 - Y +!
  94.     X @ dup 1 < if 10 X ! drop else
  95.            10 > if 1 X ! then then
  96.     Y @ dup 1 < if 10 Y ! drop else
  97.            10 > if 1 Y ! then then ;
  98. : MUT  3 0 do 5 random 8 +  A 200 + 25 random 2 * + ! loop VIEWNET ;
  99. : EVAL 
  100.     T @ 5 = if SC @ 0= if 50 T ! then then
  101.     DIR @ 0> if JUMPAWAY then
  102.     1 T +!  T @ 50 > if  0 T !  ?BUTTON if QUIT then 
  103.         200 80 !PEN
  104.         SC @ SCM @ 1 - > if  ." Store            " 
  105.             SC @ MAX @ > if SC @ MAX ! then
  106.             SC @ SCM ! 250 200 Do A I + @  B I + !  2 +Loop  else
  107.         SC @ SCM @ < if ." Restore      " SC @ 11 < if -1 SCM +! then
  108.             250 200 Do B I + @  A I + !  2 +Loop  
  109.             then else MUT then
  110.         1 GEN +! 200 GEN @ + 60 SC0 @ - !PEN 201 GEN @ + 60 SC @ - -TO 
  111.         GEN @ 300 = if 0 GEN ! page 
  112.             130 0 !pen 130 115 -to 0 115 -to then
  113.         SC @ SC0 !  0 SC ! then ;
  114. : VIEW  
  115.     12 2 do 50 I 2 - * 50 + 136 !PEN A I + @ .   2 +Loop     
  116.     150 208 !pen A 20 + @ . 250 208 !pen A 22 + @ .
  117.     350 208 !pen A 24 + @ .                     
  118.     200 282 !pen A 26 + @ . 300 282 !pen A 28 + @ .     
  119.     X 8 + @ 11 *  Y 8 + @ 11 * !PEN ."   "    
  120.     X @ 11 *  Y @ 11 * !PEN ."  O"
  121.     X 6 + @ 11 *  Y 6 + @ 11 * !PEN ."   "
  122.     X 2 + @ 11 *  Y 2 + @ 11 * !PEN HEAD @ . ."  "
  123.     200 94 !PEN ." Score: " SC0 @ . ."   (max: " MAX @ .  ." out of 50)  "
  124.     X 2 + @  X 6 + !   Y 2 + @  Y 6 + !
  125.     X @  X 8 + !   Y @  Y 8 + ! ; 
  126. : CHASENET INIT Begin INPUT THINK OUTPUT EVAL VIEW Again ;
  127. READY                            \ "echo on"
  128. CHASENET                         \ "types CHASENET to run itself"
  129.  
  130.